00100	C**** PLTCMD, FILLER, NNN, UNPACK, ROFF ********
00200		SUBROUTINE PLTCMD
00300	CC	IMPLICIT INTEGER(A-Q,S-Z)
00400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00500		DIMENSION NMS(8),RMOV1(8),RMOV2(8)
00600		COMMON /DL/X22,SAVER,NAME /ALF/INP(3),ML
00700		COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)/XAP/JXG(1),IXG(4000)
00800		EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
00900		1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(I3,INP(3))
01000		F78F(1)='(78F)'
01100		FA5(1)='(A5) '
01200		FA1(1)='(A1) '
01300	
01400		IF(I2.NE.'X')GO TO 1
01500	CC	ML=' '
01600		I2=0
01700		RXC=0
01800		RMOV1(1)='Y'
01900		NAME=0
02000	14	KA=0
02100	3	KA=KA+1
02200	CC	IF(ML.EQ.' ')GO TO 15
02300		IF(ML.EQ.0)GO TO 15
02400		K=K-2
02500		ML=ML-1
02600		IF(ML.EQ.0)GO TO 10
02700		GO TO 31
02800	15	TYPE 2,KA
02900		ACCEPT 11,K,ML
03000	C  TYPE LAST NAME, NUMBER  FOR A SERIES
03100	50	IF(K.EQ.' ')GO TO 10
03200		IF(K.EQ.'99')GO TO 140
03300	C  99=BACKUP
03400	31	IF(LOOKD(K))GO TO 56
03500	C JUMP IF FILE FOUND
03600		TYPE 55
03700		GO TO 15
03800	55	FORMAT(' FILE NOT FOUND'/)
03900	11	FORMAT(A5,I)
04000	56	NMS(KA)=K
04100	CC	IF(ML.EQ.' ')GO TO 5
04200		IF(ML.EQ.0)GO TO 5
04300		RJH='Y'
04400		GO TO 21
04500	5	TYPE 8
04600		ACCEPT FA5,RJH
04700		IF(RJH.EQ.'99')GO TO 15
04800		IF(RJH.NE.'Y')RJH=0
04900		IF(RJH.EQ.0)REREAD F78F,RJH
05000	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
05100	21	RMOV1(KA+1)=RJH
05200		RMOV2(KA)=RJH
05300		GO TO 3
05400	140	KA=KA-1
05500		GO TO 15
05600	
05700	10	KB=KA-1
05800		IF(I3.NE.'G')GO TO 22
05900		RSIZ=1
06000		GO TO 222
06100	22	TYPE 9
06200		ACCEPT F78F,RSIZ
06300		IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
06400	222	KA=0
06500	
06600	1	IF(NAME.NE.0)GO TO 12
06700		IF(KA.EQ.KB)GO TO 1000
06800		NAME=NMS(KA+1)
06900		TYPE 111,NAME
07000		RETURN
07100	12	KA=KA+1
07200		NAME=0
07300		RJD=1
07400		IF(INP(3).EQ.'C')RJD=0
07500	C  'PXC' = CALCOMP OUTPUT
07600		RJH=0
07700		RJB=RSIZ
07800		RJC=RSIZ
07900		RJG=0
08000		RJE=1
08100		RJF=1
08200		IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
08300		IF(RMOV1(KA).NE.0)RJE=0
08400		IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
08500	2	FORMAT(' TYPE FILE NAME',I2,1X$)
08600	8	FORMAT(' MOVE UP AT END? ',$)
08700	9	FORMAT(' SIZE FACTOR? ',$)
08800	111	FORMAT(1XA5/)
08900		RETURN
08910	1000	JXG(1)=JXG(3)+2
08920		CALL SAVB(JXG)
08925		CALL EXIT
08930		END
09000		SUBROUTINE OLDFIL(IFILL,QJB,QCENT,BX,BY)
09100		DIMENSION IFILL(1)
09200		COMMON /DL/IXRX,SAVER,NAME
09300		COMMON /SIZ/RSZ,JCEN,KCEN
09400		COMMON /FL/IC,N,NQ,RZ,XGP
09500		COMMON /STF/RSTFAC(8),RSTJC
09600		COMMON /PLTR/IPLT,RHT,DIS
09700		COMMON/DPY/IGO,RXGP,ITOP,IBOT
09800		PX=1
09900		IF(BX.EQ.0)BX=1
10000		IF(BY.EQ.0)BY=1
10100		IF(BX)PX=-1
10200		IXGP=XGP
10300		RSI=RSTJC*BY
10400	C  RI IS INVERSION FACTOR
10500		BZ=BY/BX
10600		RT=RSTJC*BX
10700	C  RS=HORIZ.    RT=VERT.
10800		JXGP=RXGP
10900		NX=2
11000	C  NX IS POINTER IN X ARRAY
11100		ID=IFILL(NX)
11200		IF(IPLT)GO TO 101
11300		RBZ=QJB*RSZ
11400		RXX=RSZ*RT
11500	C  WHAT ABOUT RXX???????? 
11600		RYX=QCENT*RSZ
11700		RXY=RSI*RSZ
11800		GO TO 100
11900	101	RXX=RT*DIS
12000		RXY=RSI*RHT
12100		RBZ=QJB*DIS
12200		RYX=QCENT*RHT
12300	100	RM=-1000
12400		IF(PX)RM=-RM
12500		I=NX+1
12600	103	CALL UNPACK(IA,IB,IFILL(I))
12700		IF(IA.NE.IFILL(I+1)/10000)GO TO 102
12800		I=I+1
12900		GO TO 103
13000	102	G=IA*RT+QJB
13100		H=IB*RSI+QCENT
13200		IF(IPLT)GO TO 200
13300		CALL LINES(G,H,3)
13400		GO TO 300
13500	200	IF(IXRX.EQ.0)GO TO 90
13600		M=ROFF(-H*RHT+RXGP)
13700		N=ROFF(G*DIS+XGP)
13800		GO TO 80
13900	90	M=ROFF(G*DIS)
14000		N=ROFF(H*RHT)
14100	80	CALL PLOT(M,N,3)
14200	300	NN=ID-1
14300	C  LAST OF ARRAY-1
14400		P=IA*RXX
14500		CALL UNPACK(IG,H,IFILL(I+1))
14600		RB=IG*RXX+PX
14700		J=1
14800	1	JJ=1
14900		IF(PX)GO TO 30
15000		IF(RM.GT.RB)GO TO 13
15100		GO TO 31
15200	30	IF(RM.LT.RB)GO TO 13
15300	31	IF(J)GO TO 2
15400	3	CALL NNN(NN,1,0,IFILL)
15500	C  FINDS BOTTOM POINTER
15600		GO TO 16	
15700	2	CALL NNN(I,0,1,IFILL)
15800	C  FINDS TOP POINTER(I)
15900	16	CALL UNPACK(JAX,JB,IFILL(N))
16000		CALL UNPACK(JG,JH,IFILL(N+1))
16100		CALL UNPACK(IQ,H,IFILL(NQ))
16200		RZ=RZ*RXX
16300	10	RDIS=JAX-JG
16400		IF(PX)GO TO 32
16500		IF(P.GT.RZ)P=RZ
16600		GO TO 33
16700	32	IF(P.LT.RZ)P=RZ
16800	C  REVERSES VERT.
16900	33	Q=IQ*RXX
17000		C=IC*RXY+RYX
17100		IF(RDIS.NE.0)GO TO 6
17200	C  FOR STRAIIGHT UP-DOWN LINES
17300		IF(NN-1.EQ.I)GO TO 13
17400		P=P-PX
17500		GO TO 5
17600	6	H=BZ*(JB-JH)/RDIS
17700	11	HH=(P-Q)*H+C
17800		PP=P+RBZ
17900		IH=ROFF(HH)
18000		IP=ROFF(PP)
18100	C  ROFF IS FOR ROUND-OFF ERRORS
18200		IF(IP.EQ.MP.AND.IH.EQ.MH)GO TO 180
18300		MP=IP
18400		MH=IH
18500	C  OMITS REPEATED POINTS
18600		IF(IPLT)GO TO 17
18700	CC	IF(RSZ.LE.0.8571)GO TO 34
18800	CC	IP=IP-JCEN
18900	CC	IH=IH-KCEN
19000	CC34	CALL AVECT(IP,IH)
19100		CALL LINES(PP/RSZ,HH/RSZ,2)
19200		GO TO 180
19300	17	IF(IXRX.EQ.0)GO TO 19
19400		K=IP
19500		IP=-IH+JXGP
19600	C NO RNDOFF OR DIS-RHT FACTORS HERE YET.
19700		IH=K+IXGP
19800	19	CALL PLOT(IP,IH,2)
19900	180	JJ=JJ-1
20000		IF(JJ)GO TO 12
20100		RM=P
20200		P=P+PX
20300		IF(PX)GO TO 35
20400		IF(P.LT.RZ)GO TO 11
20500		GO TO 5
20600	35	IF(P.GT.RZ)GO TO 11
20700	5	IF(J)GO TO 4
20800		NN=NN-1
20900		IF(I.GT.NN)GO TO 13
21000		GO TO 3
21100	4	I=I+1
21200		IF(I.GT.NN)GO TO 13
21300	402	CALL UNPACK(IA,IB,IFILL(I+1))
21400		RB=IA*RXX+PX
21500		GO TO 2
21600	12	J=-J
21700		GO TO 1
21800	13	NX=ID+1
21900		IF(ID.EQ.IFILL(1))GO TO 130
22000		ID=IFILL(NX)
22100		GO TO 100
22200	130	MP=1000
22300		MH=1000
22400		RETURN
22500		END
22600	
22700		SUBROUTINE NNN(J,L,K,IFILL)
22800		COMMON /FL/IC,N,NQ,RZ,XGP
22900		DIMENSION IFILL(1)
23000		CALL UNPACK(IZ,IC,IFILL(J+K))
23100		CALL UNPACK(N,IC,IFILL(J+L))
23200		N=J
23300	C  C IS THE CONSTANT
23400		NQ=N+L
23500		RZ=IZ
23600		RETURN
23700		END
23800	
23900		SUBROUTINE UNPACK(M,N,I)
24000		COMMON/LL/L
24100	C  L IS FOR VIS. OR INVIS. LINES.
24200		N=I
24300		L=2
24400		M=N/100000000
24500		IF(M.EQ.0)GO TO 2
24600		L=3
24700		N=N-100000000*M
24800	2	M=N/10000
24900	CC	N=N-M*10000
25000		N=MOD(N,10000)
25100		IF(M.GT.1000)M=1000-M
25200		IF(N.GT.1000)N=1000-N
25300		END
25400	
25410		FUNCTION ROFF(R)
25420		S=.5
25430		IF(R)S=-S
25440		ROFF=R+S
25450		END
25460	
25500	C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
25600		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
25700		COMMON/DL/IXRX,SAVER,NAME
25800		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
25900		DIMENSION IDAT(1)
26000		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
26100		DATA MP/2/,MD/6/
26200	C MD=DISPLAY   MP=PLOTTER   MX=XGP
26300		DX=DIS
26400		RX=RHT
26500		D=RSTJC*RJF
26600		R=RSTJC*RJG
26700	4	GO TO 1
26800		C=CC
26900		B=BB
27000	C  SAVES IT.  IT WILL RETURN LATER.
27100		BB=B/DIS
27200		CC=1000
27300	1	KK=0
27400		DO 205 J=1,L
27500		CALL UNPACK(M,N,IDAT(J))
27600		KK=KK+1
27700		NX(KK)=0
27800		IF(LL.EQ.3)NX(KK)=3
27900		X(KK)=ROFF((RJB+D*M)*DIS)
28000		Y(KK)=ROFF((CENTR+R*N)*RHT)
28100	3	GO TO 205
28200		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
28300	C  FOR DISTORTION
28400	205	CONTINUE
28500		NX(1)=KK
28600		DIS=1.0
28700		RHT=DIS
28800		M=MD
28900		IF(IPLT)M=MP-IXRX
29000	C  STOPS DISTORTION IN 'LINES'
29100	2	CALL FILLER(X,Y,NX,M)
29200		DIS=DX
29300		RHT=RX
29400	5	RETURN
29500	C  NEXT TO RESET DISTORTION FACT.
29600		BB=B
29700		CC=C
29800		RETURN
29900		END
30000	
30100		SUBROUTINE ROTATE(I,L,DEG)
30200		DIMENSION I(1)
30300		N=I(L)
30400		KNT=501
30500	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 501.
30600		I(KNT)=N
30700		DO 1 K=L+1,N+L-1
30800		CALL UNPACK(J,M,I(K))
30900		X=J
31000		Y=M
31100		JJ=I(K)/100000000
31200		AX=ATAN2(X,Y)*57.29578
31300		HYP=SQRT(X**2+Y**2)
31400		ROT=DEG+AX
31500		J=HYP*COSD(ROT)
31600		M=HYP*SIND(ROT)
31700		KNT=KNT+1
31800		IF(J)J=1000-J
31900		IF(M)M=1000-M
32000	1	I(KNT)=M*10000+J+JJ*100000000
32100		L=501
32200		END